home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / mail1.arc / MAIL1.BAS
Encoding:
BASIC Source File  |  1986-06-11  |  23.7 KB  |  551 lines
  1. 0  GOTO 2
  2. 1 SAVE"MAIL1.BAS":STOP
  3. 2 '
  4. 5 '
  5. 10 '    0-1-3 0 103.-1-1*************************
  6. 20 '   ***     MAILING LIST PROGRAM   v.1.0   ***
  7. 30 '   ******************************************
  8. 40 '
  9. 50 '   by Joe Long                       for IBM PC
  10. 60 '   Rt. 1 Box 100                     up to 1,000 records
  11. 70 '   Madison, AL  35758
  12. 75 '
  13. 80 '               ***    Copyright 1983 by Joe Long   ***
  14. 85 '   ** Permission to copy for private use and FREE distribution granted   **
  15. 90 '
  16. 100 DEFINT A-Z : DIM SORT$(1000), SORT(1000), FILL$(50), FRERECNUM$(50)
  17. 110 ON ERROR GOTO 9900
  18. 120 FG=7 : BG=0 : BD=0 : HI = 15  '   Color variables
  19. 130 COLOR FG,BG,BD : KEY OFF : CLS
  20. 140 ON KEY(1) GOSUB 2000: ON KEY(2) GOSUB 3000: ON KEY(3) GOSUB 4000: ON KEY(4) GOSUB 5000: ON KEY(5) GOSUB 4200: ON KEY(6) GOSUB 4400: ON KEY(7) GOSUB 4600: ON KEY(8) GOSUB 4800: ON KEY(9) GOSUB 500: ON KEY(10) GOSUB 400
  21. 150 KEY(1) ON: KEY(2) ON: KEY(3) ON: KEY(4) ON: KEY(5) ON: KEY(6) ON: KEY(7) ON: KEY(8) ON: KEY(9) ON: KEY(10) ON
  22. 155 DRIVE$="B:" ' Change for different data drive - Mod by A. Lantos 10/27/84
  23. 160 OPEN "R",1,DRIVE$+"MAILLIST.TXT"
  24. 170 FIELD 1, 20 AS SCRDATA$(1), 1 AS SCRDATA$(2), 16 AS SCRDATA$(3), 34 AS SCRDATA$(4), 18 AS SCRDATA$(5), 2 AS SCRDATA$(6), 5 AS SCRDATA$(7), 16 AS SCRDATA$(8), 8 AS SCRDATA$(9), 8 AS SCRDATA$(10)
  25. 175 FIELD 1, 20 AS FILL$, 1 AS SORTFLAG$, 107 AS FILLER$
  26. 176 FOR I = 1 TO 50
  27. 177   FIELD 1, 19 + 2*I AS FILL$(I), 2 AS FRERECNUM$(I)
  28. 178 NEXT I
  29. 180 OPEN "R",2,DRIVE$+"NAMEINDX.TXT",18
  30. 190 FIELD 2, 16 AS NAMEINDEX$, 2 AS NAMERECORD$
  31. 200 OPEN "R",3,DRIVE$+"ZIPINDEX.TXT",7
  32. 210 FIELD 3, 5 AS ZIPINDEX$, 2 AS ZIPRECORD$
  33. 220 OPEN "R",4,DRIVE$+"CITYINDX.TXT",20
  34. 230 FIELD 4, 18 AS CITYINDEX$, 2 AS CITYRECORD$
  35. 240 OPEN "R",5,DRIVE$+"STATEIDX.TXT",4
  36. 250 FIELD 5, 2 AS STATEINDEX$, 2 AS STATERECORD$
  37. 260 GET 1,1
  38. 270 IF FILL$ = "                    " THEN 300
  39. 280 LSET FILL$ = "" : LSET SORTFLAG$ = "" : LSET FILLER$ = ""
  40. 290 PUT 1,1
  41. 300 IF ASC(SORTFLAG$) = 2 THEN 350
  42. 310 PRINT : PRINT "The file has been modified since last sorted."
  43. 320 PRINT : PRINT "Do you want to sort the index files? ";
  44. 330 GOSUB 9100
  45. 340 IF YES = 1 THEN GOSUB 3000
  46. 350 GOTO 1000
  47. 390 '
  48. 400 '   ***   Ending Routine   ***
  49. 410 '
  50. 420 LOCATE 22,10 : COLOR FG,BG : PRINT "Do you really want to end the program? ";
  51. 430 GOSUB 9100
  52. 440 IF YES = 0 THEN MENU = 0 : LOCATE 22,10 : PRINT STRING$(70," ") : RETURN
  53. 450 CLS : PRINT : PRINT TAB(36) "End of program." : PRINT
  54. 460 END
  55. 500 '   ***   Restart routine   ***
  56. 510 '
  57. 520 CLOSE : RUN
  58. 980 '
  59. 990 '    ******************************
  60. 1000 '   ***   MAIN MENU ROUTINES   ***
  61. 1010 '   ******************************
  62. 1015 '
  63. 1020 CLS : PRINT : PRINT TAB(30) "MAILLIST Main Menu"
  64. 1030 PRINT : PRINT TAB(10) "Key" : PRINT TAB(54) "Function"
  65. 1040 PRINT TAB(10)"---" : PRINT TAB(50) "----------------"
  66. 1050 PRINT : PRINT TAB(10)"F1"; : PRINT TAB(50) "Add name to list"
  67. 1070 PRINT : PRINT TAB(10)"F2"; : PRINT TAB(50) "Sort list"
  68. 1080 PRINT : PRINT TAB(10)"F3"; : PRINT TAB(50) "Search/edit record"
  69. 1090 PRINT : PRINT TAB(10)"F4"; : PRINT TAB(50) "Print labels"
  70. 1100 PRINT : PRINT TAB(10)"F10"; : PRINT TAB(50) "Exit program"
  71. 1110 MENU=1
  72. 1120 IF MENU=1 THEN GOTO 1120 ELSE GOTO 1000
  73. 1480 '
  74. 1490 '   **************************************************************
  75. 1500 '   ***   Maintain list of free (deleted) records for re-use   ***
  76. 1510 '   **************************************************************
  77. 1590 '
  78. 1600 '   ***   Find free record   ***
  79. 1610 '
  80. 1620 GET 1,1
  81. 1630 FOR I = 50 TO 1 STEP -1
  82. 1640   IF FRERECNUM$(I) <> "  " THEN 1690
  83. 1650 NEXT I
  84. 1660 RECORD = LOF(1)/128 + 1 : TRIAL = RECORD
  85. 1670 RETURN
  86. 1690 RECORD = CVI(FRERECNUM$(I))
  87. 1700 TRIAL = LOF(1)/128 : GET 2, TRIAL      '   Find free index record
  88. 1710 WHILE NAMEINDEX$ = "________________"
  89. 1720 TRIAL = TRIAL - 1
  90. 1730 GET 2, TRIAL
  91. 1740   WEND
  92. 1750 LSET FRERECNUM$(I) = "" : PUT 1,1   '  delete stored record #
  93. 1760 RETURN
  94. 1790 '
  95. 1800 '   ***   Store deleted record number   ***
  96. 1810 '
  97. 1820 GET 1,1
  98. 1830 FOR I = 1 TO 50
  99. 1840   IF FRERECNUM$(I) = "  " THEN 1870
  100. 1850 NEXT I
  101. 1860 RETURN   '   discard if 50 free records stored
  102. 1870 LSET FRERECNUM$(I) = MKI$(RECORD)
  103. 1880 PUT 1,1
  104. 1890 RETURN
  105. 1980 '
  106. 1990 '   *****************************
  107. 2000 '   ***   Add names to list   ***
  108. 2010 '   *****************************
  109. 2020 '
  110. 2030 MENU=0
  111. 2040 GOSUB 1500     '   get next record #
  112. 2050 GOSUB 8100     '   Print blank form on screen
  113. 2060 RESTORE : READ DUMMY, DUMMY, DUMMY   '   set data for cursor advance
  114. 2070 ROW=4 : COL=13      '   set initial cursor location
  115. 2080 GOSUB 8500
  116. 2090 RESTORE : GOSUB 8800
  117. 2110 GOSUB 6100                '   Save to disc
  118. 2120 RETURN
  119. 2980 '
  120. 2990 '   ************************
  121. 3000 '   ***   Sort Indexes   ***
  122. 3010 '   ************************
  123. 3015 '
  124. 3020 MENU = 0
  125. 3030 LASTRECORD = LOF(1)/128
  126. 3040 CLS : PRINT "Reading last name index file."
  127. 3090 '
  128. 3100 '   ***   Sort Name Index    ***
  129. 3110 '
  130. 3120 FOR I = 1 TO LASTRECORD
  131. 3130   GET 2,I : SORT$(I) = NAMEINDEX$ : SORT(I) = CVI(NAMERECORD$)
  132. 3140 NEXT I
  133. 3150 PRINT "Last name index read ... now sorting last name index."
  134. 3160 GOSUB 9400
  135. 3170 PRINT "Sorting complete ... now writing sorted last name index."
  136. 3180 FOR I = 1 TO LASTRECORD
  137. 3190   LSET NAMEINDEX$ = SORT$(I) : LSET NAMERECORD$ = MKI$(SORT(I))
  138. 3200   PUT 2,I
  139. 3210 NEXT I
  140. 3220 PRINT "Last name index file written ... now reading zip code index file."
  141. 3290 '
  142. 3300 '   ***   Sort zip code index   ***
  143. 3310 '
  144. 3320 FOR I = 1 TO LASTRECORD
  145. 3330   GET 3,I : SORT$(I) = ZIPINDEX$ : SORT(I) = CVI(ZIPRECORD$)
  146. 3340 NEXT I
  147. 3350 PRINT "Zip code index file read ... now sorting zip code index."
  148. 3360 GOSUB 9400
  149. 3370 PRINT "Sorting complete ... now writing sorted zip code index file."
  150. 3380 FOR I = 1 TO LASTRECORD
  151. 3390   LSET ZIPINDEX$ = SORT$(I) : LSET ZIPRECORD$ = MKI$(SORT(I))
  152. 3400   PUT 3,I
  153. 3410 NEXT I
  154. 3420 PRINT "Zip code index file written ... reading City index file."
  155. 3490 '
  156. 3500 '   ***   Sort City Index   ***
  157. 3510 '
  158. 3520 FOR I = 1 TO LASTRECORD
  159. 3530   GET 4,I : SORT$(I) = CITYINDEX$ : SORT(I) = CVI(CITYRECORD$)
  160. 3540 NEXT I
  161. 3550 PRINT "City index file read ... now sorting City index."
  162. 3560 GOSUB 9400
  163. 3570 PRINT "Sorting complete ... now writing sorted City index file."
  164. 3580 FOR I = 1 TO LASTRECORD
  165. 3590   LSET CITYINDEX$ = SORT$(I) : LSET CITYRECORD$ = MKI$(SORT(I))
  166. 3600   PUT 4,I
  167. 3610 NEXT I
  168. 3620 PRINT "City index file written ... reading State index file."
  169. 3690 '
  170. 3700 '   ***   Sort State index   ***
  171. 3710 '
  172. 3720 FOR I = 1 TO LASTRECORD
  173. 3730   GET 5,I : SORT$(I) = STATEINDEX$ : SORT(I) = CVI(STATERECORD$)
  174. 3740 NEXT I
  175. 3750 PRINT "State index file read ... now sorting State index file."
  176. 3760 GOSUB 9400
  177. 3770 PRINT "Sorting complete ... now writing sorted State index file."
  178. 3780 FOR I = 1 TO LASTRECORD
  179. 3790   LSET STATEINDEX$ = SORT$(I) : LSET STATERECORD$ = MKI$(SORT(I))
  180. 3800   PUT 5,I
  181. 3810 NEXT I
  182. 3820 BEEP : PRINT "State index file written ... all sorting completed."
  183. 3830 LSET FILL1$ = "" : LSET SORTFLAG$ = CHR$(2) : LSET FILL2$ = ""
  184. 3840 PUT 1,1
  185. 3850 FOR I = 1 TO 1000 : NEXT I
  186. 3860 RETURN
  187. 3980 '
  188. 3990 '   ***********************************
  189. 4000 '   ***   Search and Edit Records   ***
  190. 4010 '   ***********************************
  191. 4020 '
  192. 4030 LASTRECORD = LOF(1)/128
  193. 4090 '
  194. 4100 '   ***   Search Menu   ***
  195. 4110 '
  196. 4120 CLS : MENU = 1 : PRINT : PRINT TAB(10) "Key";: PRINT TAB(50) "Type of Search"
  197. 4130 PRINT TAB(10) "___";: PRINT TAB(50) "______________"
  198. 4140 PRINT : PRINT TAB(11) "F5";: PRINT TAB(50) "Last Name"
  199. 4150 PRINT : PRINT TAB(11) "F6";: PRINT TAB(50) "Zip Code"
  200. 4160 PRINT : PRINT TAB(11) "F7";: PRINT TAB(50) "City"
  201. 4170 PRINT : PRINT TAB(11) "F8";: PRINT TAB(50) "State"
  202. 4180 PRINT : PRINT TAB(11) "F9";: PRINT TAB(50) "Return to Main Menu"
  203. 4190 IF MENU = 1 THEN GOTO 4190 ELSE MENU = 1 : GOTO 4120
  204. 4195 '
  205. 4200 '   ***   Search by last name   ***
  206. 4210 '
  207. 4220 CLS : MENU = 0 : LASTRECORD = LOF(1)/128
  208. 4240 PRINT : INPUT "Last name for search"; LASTNAME$
  209. 4250 NAMELENGTH = LEN(LASTNAME$)
  210. 4260 LOWLIMIT = 0 : HIGHLIMIT = LASTRECORD
  211. 4270 TRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+.5)
  212. 4280 GET 2, TRIAL : RECORD = CVI(NAMERECORD$)
  213. 4290 IF LEFT$(NAMEINDEX$,NAMELENGTH) = LASTNAME$ THEN GOSUB 9700 : GOTO 4340
  214. 4300 IF NAMEINDEX$ < LASTNAME$ THEN LOWLIMIT = TRIAL
  215. 4310 IF NAMEINDEX$ > LASTNAME$ THEN HIGHLIMIT = TRIAL
  216. 4320 NEWTRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+.5)
  217. 4330 IF TRIAL = NEWTRIAL THEN BEEP : PRINT "None found." : FOR I = 1 TO 500 : NEXT I : RETURN ELSE TRIAL = NEWTRIAL : GOTO 4280
  218. 4340 MATCH = TRIAL
  219. 4350 TRIAL = TRIAL - 1 : GET 2, TRIAL : RECORD = CVI(NAMERECORD$) : IF LEFT$(NAMEINDEX$,NAMELENGTH) = LASTNAME$ THEN GOSUB 9700 : GOTO 4350
  220. 4360 TRIAL = MATCH
  221. 4370 TRIAL = TRIAL + 1 : GET 2, TRIAL : RECORD = CVI(NAMERECORD$) : IF LEFT$(NAMEINDEX$,NAMELENGTH) = LASTNAME$ THEN GOSUB 9700 : GOTO 4370
  222. 4380 BEEP : PRINT "No more entries by that name." : FOR I = 1 TO 500 : NEXT I : RETURN
  223. 4390 '
  224. 4400 '   ***   Search by zip code   ***
  225. 4410 '
  226. 4420 CLS : MENU = 0 : LASTRECORD = LOF(1)/128
  227. 4440 PRINT : INPUT "Zip code for search"; ZIPCODE$
  228. 4460 LOWLIMIT = 0 : HIGHLIMIT = LASTRECORD
  229. 4470 TRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+.5)
  230. 4480 GET 3, TRIAL : RECORD = CVI(ZIPRECORD$)
  231. 4490 IF ZIPINDEX$ = ZIPCODE$ THEN GOSUB 9700 : GOTO 4540
  232. 4500 IF ZIPINDEX$ < ZIPCODE$ THEN LOWLIMIT = TRIAL
  233. 4510 IF ZIPINDEX$ > ZIPCODE$ THEN HIGHLIMIT = TRIAL
  234. 4520 NEWTRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+.5)
  235. 4530 IF TRIAL = NEWTRIAL THEN BEEP : PRINT "None found." : FOR I = 1 TO 500 : NEXT I : RETURN ELSE TRIAL = NEWTRIAL : GOTO 4480
  236. 4540 MATCH = TRIAL
  237. 4550 TRIAL = TRIAL - 1 : GET 3, TRIAL : RECORD = CVI(ZIPRECORD$) : IF ZIPINDEX$ = ZIPCODE$ THEN GOSUB 9700 : GOTO 4550
  238. 4560 TRIAL = MATCH
  239. 4570 TRIAL = TRIAL + 1 : GET 3, TRIAL : RECORD = CVI(ZIPRECORD$) : IF ZIPINDEX$ = ZIPCODE$ THEN GOSUB 9700 : GOTO 4570
  240. 4580 BEEP : PRINT "No more entries with that number." : FOR I = 1 TO 500 : NEXT I : RETURN
  241. 4590 '
  242. 4600 '   ***   Search by City   ***
  243. 4610 '
  244. 4620 CLS : MENU = 0 : LASTRECORD = LOF(1)/128
  245. 4640 PRINT : INPUT "City for search"; CITY$
  246. 4650 CITYLENGTH = LEN(CITY$)
  247. 4660 LOWLIMIT = 0 : HIGHLIMIT = LASTRECORD
  248. 4670 TRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+.5)
  249. 4680 GET 4, TRIAL : RECORD = CVI(CITYRECORD$)
  250. 4690 IF LEFT$(CITYINDEX$,CITYLENGTH) = CITY$ THEN GOSUB 9700 : GOTO 4740
  251. 4700 IF CITYINDEX$ < CITY$ THEN LOWLIMIT = TRIAL
  252. 4710 IF CITYINDEX$ > CITY$ THEN HIGHLIMIT = TRIAL
  253. 4720 NEWTRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+.5)
  254. 4730 IF TRIAL = NEWTRIAL THEN BEEP : PRINT "None found." : FOR I = 1 TO 500 : NEXT I : RETURN ELSE TRIAL = NEWTRIAL : GOTO 4680
  255. 4740 MATCH = TRIAL
  256. 4750 TRIAL = TRIAL - 1 : GET 4, TRIAL : RECORD = CVI(CITYRECORD$) : IF LEFT$(CITYINDEX$,CITYLENGTH) = CITY$ THEN GOSUB 9700 : GOTO 4750
  257. 4760 TRIAL = MATCH
  258. 4770 TRIAL = TRIAL + 1 : GET 4, TRIAL : RECORD = CVI(CITYRECORD$) : IF LEFT$(CITYINDEX$,CITYLENGTH) = CITY$ THEN GOSUB 9700 : GOTO 4770
  259. 4780 BEEP : PRINT "No more entries with that city." : FOR I = 1 TO 500 : NEXT I : RETURN
  260. 4790 '
  261. 4800 '   ***   Search by State   ***
  262. 4810 '
  263. 4820 CLS : MENU = 0 : LASTRECORD = LOF(1)/128
  264. 4840 PRINT : INPUT "State for search"; STATE$
  265. 4860 LOWLIMIT = 0 : HIGHLIMIT = LASTRECORD
  266. 4870 TRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+.5)
  267. 4880 GET 5, TRIAL : RECORD = CVI(STATERECORD$)
  268. 4890 IF STATEINDEX$ = STATE$ THEN GOSUB 9700 : GOTO 4940
  269. 4900 IF STATEINDEX$ < STATE$ THEN LOWLIMIT = TRIAL
  270. 4910 IF STATEINDEX$ > STATE$ THEN HIGHLIMIT = TRIAL
  271. 4920 NEWTRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+.5)
  272. 4930 IF TRIAL = NEWTRIAL THEN BEEP : PRINT "None found." : FOR I = 1 TO 500 : NEXT I : RETURN ELSE TRIAL = NEWTRIAL : GOTO 4880
  273. 4940 MATCH = TRIAL
  274. 4950 TRIAL = TRIAL - 1 : GET 5, TRIAL : RECORD = CVI(STATERECORD$) : IF STATEINDEX$ = STATE$ THEN GOSUB 9700 : GOTO 4950
  275. 4960 TRIAL = MATCH
  276. 4970 TRIAL = TRIAL + 1 : GET 5, TRIAL : RECORD = CVI(STATERECORD$) : IF STATEINDEX$ = STATE$ THEN GOSUB 9700 : GOTO 4970
  277. 4980 BEEP : PRINT "No more entries with that state." : FOR I = 1 TO 500 : NEXT I : RETURN
  278. 4985 '
  279. 4990 '   ************************
  280. 5000 '   ***   Print Labels   ***
  281. 5010 '   ************************
  282. 5020 '
  283. 5030 MENU = 0 : CLS
  284. 5040 PRINT : INPUT "One or two across"; LABELNUMBER
  285. 5050 IF LABELNUMBER < 1 OR LABELNUMBER > 2 THEN PRINT : PRINT "This program only prints one or two 3 1/2"; CHR$(34); "labels per row, choose (1) or (2) please." : GOTO 5040
  286. 5060 GOSUB 9200     '   Select key field
  287. 5070 PRINT : PRINTKEY$ = "" : INPUT "Key to print (or <enter> to print all)"; PRINTKEY$ : IF PRINTKEY$ = "" THEN PRINTKEY$ = "*"
  288. 5075 PRINT : PRINT "Print phone numbers? "; : GOSUB 9100
  289. 5078 IF YES = 1 THEN PHONEFLAG = 1 ELSE PHONEFLAG = 0
  290. 5080 IF LABELNUMBER = 2 THEN GOTO 5400
  291. 5090 '
  292. 5100 '   ***   Print one across labels   ***
  293. 5110 '
  294. 5120 LASTRECORD = LOF(1)/128
  295. 5130 RECORD = 0
  296. 5140 IF RECORD = LASTRECORD THEN RETURN ELSE RECORD = RECORD + 1 : GOSUB 6300    '   get next record
  297. 5150 IF KEYFIELD < 9 THEN GOTO 5240
  298. 5160 FOR I = 1 TO 8
  299. 5170   FOR J = 1 TO LEN(PRINTKEY$)
  300. 5180     IF MID$(SCREENDATA$(KEYFIELD),I,1) = MID$(PRINTKEY$,J,1) THEN GOTO 5300
  301. 5190   NEXT J
  302. 5200 NEXT I
  303. 5220 GOTO 5140
  304. 5240 IF PRINTKEY$ = "*" THEN 5300
  305. 5250  FIELDDATA$(KEYFIELD) = LEFT$(SCREENDATA$(KEYFIELD),LEN(PRINTKEY$))
  306. 5260 IF FIELDDATA$(KEYFIELD) <> PRINTKEY$ THEN GOTO 5140
  307. 5300 LPRINT : LPRINT SCREENDATA$(1);" ";
  308. 5310 IF SCREENDATA$(2) <> "" THEN LPRINT SCREENDATA$(2);". ";
  309. 5320 LPRINT SCREENDATA$(3)
  310. 5330 LPRINT SCREENDATA$(4)
  311. 5340 LPRINT SCREENDATA$(5); ", "; SCREENDATA$(6); : LPRINT TAB(25); SCREENDATA$(7)
  312. 5350 IF PHONEFLAG = 1 THEN LPRINT SCREENDATA$(8) ELSE LPRINT
  313. 5360 LPRINT
  314. 5370 GOTO 5140
  315. 5390 '
  316. 5400 '   ***   Print two across labels   ***
  317. 5410 '
  318. 5420 LASTRECORD = LOF(1)/128 : RECORD = 0 : LEFTLABEL = 1
  319. 5430 IF RECORD >= LASTRECORD THEN 5800
  320. 5440 RECORD = RECORD + 1 : GOSUB 6300   '   get next record
  321. 5450 IF KEYFIELD < 9 THEN GOTO 5540
  322. 5460 FOR I = 1 TO 8
  323. 5470   FOR J = 1 TO LEN(PRINTKEY$)
  324. 5480     IF MID$(SCREENDATA$(KEYFIELD),I,1) = MID$(PRINTKEY$,J,1) THEN GOTO 5600
  325. 5490   NEXT J
  326. 5500 NEXT I
  327. 5520 GOTO 5430
  328. 5540 IF PRINTKEY$ = "*" THEN 5600
  329. 5550  FIELDDATA$(KEYFIELD) = LEFT$(SCREENDATA$(KEYFIELD),LEN(PRINTKEY$))
  330. 5560 IF FIELDDATA$(KEYFIELD) <> PRINTKEY$ THEN GOTO 5440
  331. 5600 IF LEFTLABEL = 0 THEN 5700
  332. 5610 FOR I = 1 TO 8
  333. 5620   LABELDATA$(I) = SCREENDATA$(I)
  334. 5630 NEXT I
  335. 5640 LEFTLABEL = 0
  336. 5650 GOTO 5430
  337. 5700 LPRINT : LPRINT LABELDATA$(1); " "; : IF LABELDATA$(2) <> "" THEN LPRINT LABELDATA$(2); ". ";
  338. 5710 LPRINT LABELDATA$(3);
  339. 5720 LPRINT TAB(37) SCREENDATA$(1); " "; : IF SCREENDATA$(2) <> "" THEN LPRINT SCREENDATA$(2); ". ";
  340. 5730 LPRINT SCREENDATA$(3)
  341. 5740 LPRINT LABELDATA$(4); : LPRINT TAB(37) SCREENDATA$(4)
  342. 5750 LPRINT LABELDATA$(5); ", "; LABELDATA$(6); : LPRINT TAB(25) LABELDATA$(7);
  343. 5760 LPRINT TAB(37) SCREENDATA$(5); ", "; SCREENDATA$(6); : LPRINT TAB(62) SCREENDATA$(7)
  344. 5770 IF PHONEFLAG = 1 THEN LPRINT LABELDATA$(8); : LPRINT TAB(37) SCREENDATA$(8) ELSE LPRINT
  345. 5780 LPRINT : LEFTLABEL = 1 : GOTO 5430
  346. 5790 '
  347. 5800 '   ***   Print odd remaining label   ***
  348. 5810 '
  349. 5820 IF LEFTLABEL = 1 THEN RETURN
  350. 5830 LPRINT : LPRINT LABELDATA$(1); " "; : IF LABELDATA$(2) <> "" THEN LPRINT LABELDATA$(2); ". ";
  351. 5840 LPRINT LABELDATA$(3)
  352. 5850 LPRINT LABELDATA$(4)
  353. 5860 LPRINT LABELDATA$(5); ", "; LABELDATA$(6); : LPRINT TAB(25) LABELDATA$(7)
  354. 5870 IF PHONEFLAG = 1 THEN LPRINT LABELDATA$(8) : LPRINT ELSE LPRINT : LPRINT
  355. 5890 RETURN
  356. 5980 '
  357. 5990 '   *****************************
  358. 6000 '   ***   MAIN I/O ROUTINES   ***
  359. 6010 '   *****************************
  360. 6090 '
  361. 6100 '   ***   Write Record to File   ***
  362. 6110 '
  363. 6140 FOR I=1 TO 10
  364. 6150   LSET SCRDATA$(I) = SCREENDATA$(I)
  365. 6160 NEXT I
  366. 6170 PUT 1, RECORD
  367. 6180 LSET NAMEINDEX$ = SCREENDATA$(3) : LSET NAMERECORD$ = MKI$(RECORD)
  368. 6190 PUT 2, TRIAL
  369. 6200 LSET ZIPINDEX$ = SCREENDATA$(7) : LSET ZIPRECORD$ = MKI$(RECORD)
  370. 6210 PUT 3, TRIAL
  371. 6220 LSET CITYINDEX$ = SCREENDATA$(5) : LSET CITYRECORD$ = MKI$(RECORD)
  372. 6230 PUT 4, TRIAL
  373. 6240 LSET STATEINDEX$ = SCREENDATA$(6) : LSET STATERECORD$ = MKI$(RECORD)
  374. 6250 PUT 5, TRIAL
  375. 6260 GET 1,1
  376. 6270 LSET FILL$ = "" : LSET SORTFLAG$ = ""
  377. 6280 PUT 1,1 : RETURN
  378. 6290 '
  379. 6300 '   ***   Read Record from File   ***
  380. 6310 '
  381. 6330 GET 1, RECORD
  382. 6340 FOR I = 1 TO 10
  383. 6350   SCREENDATA$(I) = SCRDATA$(I)
  384. 6360   FOR J = LEN(SCREENDATA$(I)) TO 1 STEP -1
  385. 6370     IF MID$(SCREENDATA$(I),J,1) <> "_" THEN 6400
  386. 6380   NEXT J
  387. 6390   SCREENDATA$(I) = ""   '   change blank string to null string
  388. 6400   SCREENDATA$(I) = LEFT$(SCREENDATA$(I),J)
  389. 6410 NEXT I
  390. 6420 RETURN
  391. 7980 '
  392. 7990 '   ***********************************
  393. 8000 '   ***   Display I/O Subroutines   ***
  394. 8010 '   ***********************************
  395. 8090 '
  396. 8100 '   ***   Print Form on Screen   ***
  397. 8110 '
  398. 8120 CLS : PRINT : PRINT TAB(20) "Record Number"; RECORD
  399. 8130 PRINT : PRINT "First Name: ";STRING$(20,"_"); "     M.I.: __     Last Name: ";STRING$(16,"_")
  400. 8140 PRINT : PRINT "Address: "; STRING$(34,"_")
  401. 8150 PRINT : PRINT "City: "; STRING$(18,"_"); "     State: __     Zip: "; STRING$(5,"_")
  402. 8160 PRINT : PRINT "Phone: ";STRING$(16,"_")
  403. 8170 PRINT : PRINT "Activity Key: "; STRING$(8,"_")
  404. 8180 PRINT : PRINT "Membership Key: ";STRING$(8,"_")
  405. 8190 PRINT : PRINT : PRINT TAB(22) "(Press <Esc> to delete record)"
  406. 8200 PRINT : PRINT TAB(12) "(Forward tab to next item, <Enter> to exit form)"
  407. 8210 RETURN
  408. 8390 '
  409. 8400 '   ***   Print Data on Screen   ***
  410. 8410 '
  411. 8420 COLOR HI, BG
  412. 8430 FOR I = 1 TO 10
  413. 8440   READ ROWDATA, COLDATA, LENDATA
  414. 8450   LOCATE ROWDATA,COLDATA : PRINT SCREENDATA$(I);
  415. 8460 NEXT I
  416. 8470 RETURN
  417. 8490 '
  418. 8500 '   ***   Process Keyboard Inputs to Screen  ***
  419. 8510 '
  420. 8520 COLORVAL = SCREEN(ROW,COL,1) : COLORFORE = (COLORVAL MOD 16) : CHARACTER = SCREEN(ROW,COL)
  421. 8530 LOCATE ROW,COL : COLOR BG,COLORFORE : PRINT CHR$(CHARACTER);
  422. 8540 FOR I = 1 TO 30
  423. 8550   DATUM$ = INKEY$ : IF DATUM$ <> "" THEN GOTO 8620
  424. 8560 NEXT I
  425. 8570 LOCATE ROW,COL : COLOR COLORFORE,BG : PRINT CHR$(SCREEN(ROW,COL));
  426. 8580 FOR I = 1 TO 30
  427. 8590   DATUM$ = INKEY$ : IF DATUM$ <> "" THEN GOTO 8620
  428. 8600 NEXT I
  429. 8610 GOTO 8530
  430. 8620 LOCATE ROW,COL : COLOR COLORFORE,BG : PRINT CHR$(SCREEN(ROW,COL));
  431. 8625 IF ASC(DATUM$) = 27 THEN 9600     '   delete entry
  432. 8630 IF LEN(DATUM$) = 1 THEN GOTO 8700
  433. 8640 CURMOVE = ASC(RIGHT$(DATUM$,1))
  434. 8650 IF CURMOVE = 77 THEN COL = COL + 1 : IF COL > 80 THEN COL = 1 : ROW = ROW + 1 : IF ROW = 24 THEN ROW = 23 : COL = 80
  435. 8660 IF CURMOVE = 75 THEN COL = COL - 1 : IF COL < 1 THEN COL = 80 : ROW = ROW - 1 : IF ROW = 0 THEN ROW = 1 : COL = 1
  436. 8670 IF CURMOVE = 80 THEN ROW = ROW + 1 : IF ROW = 24 THEN ROW = 23
  437. 8680 IF CURMOVE = 72 THEN ROW = ROW - 1 : IF ROW = 0 THEN ROW = 1
  438. 8685 IF CURMOVE = 83 THEN LOCATE ROW,COL : IF COLORFORE = 15 THEN COLOR FG,BG : PRINT "_";
  439. 8690 GOTO 8520
  440. 8700 VALDATUM = ASC(DATUM$)
  441. 8710 IF VALDATUM = 9 THEN COLOR COLORFORE,BG : LOCATE ROW,COL : PRINT CHR$(CHARACTER) : READ ROW,COL,LENDATA : IF ROW = 1 THEN RETURN ELSE GOTO 8500
  442. 8720 IF VALDATUM = 13 THEN RETURN
  443. 8730 IF VALDATUM < 31 OR VALDATUM > 127 THEN GOTO 8760
  444. 8740 LOCATE ROW,COL : COLOR HI,BG : PRINT DATUM$;
  445. 8750 COL = COL + 1 : IF COL > 80 THEN COL = 1 : ROW = ROW + 1 : IF ROW = 24 THEN ROW = 23 : COL = 80
  446. 8760 IF VALDATUM = 8 THEN LOCATE ROW,COL : COLOR FG,BG : PRINT "_"; : COL = COL - 1 : IF COL < 1 THEN COL = 80 : ROW = ROW - 1 : IF ROW = 0 THEN ROW = 1 : COL = 1
  447. 8770 GOTO 8520
  448. 8790 '
  449. 8800 '   ***   Read data from screen   ***
  450. 8810 '
  451. 8820 FOR I = 1 TO 10
  452. 8830   SCREENDATA$(I) = "" : READ ROWDATA, COLDATA, LENDATA
  453. 8840   FOR J = 0 TO LENDATA -1
  454. 8850     SCREENDATA$(I) = SCREENDATA$(I) + CHR$(SCREEN(ROWDATA,COLDATA+J))
  455. 8860   NEXT J
  456. 8870 NEXT I
  457. 8880 RETURN
  458. 8890 '
  459. 8900 '   ***   Data statements for form data locations   ***
  460. 8910 '
  461. 8920 DATA 4,13,20,4,44,1,4,62,16,6,10,34,8,7,18,8,37,2,8,49,5
  462. 8930 DATA 10,8,16,12,15,8,14,17,8,1,1,1
  463. 8980 '
  464. 8990 '   *************************************
  465. 9000 '   ***   Miscellaneous Subroutines   ***
  466. 9010 '   *************************************
  467. 9090 '
  468. 9100 '   ***   Process Yes/No Inputs   ***
  469. 9110 '
  470. 9115 ENTRY$ = INKEY$
  471. 9120 ENTRY$ = INKEY$ : IF ENTRY$ = "" THEN 9120
  472. 9130 IF ENTRY$ = "Y" OR ENTRY$ = "y" THEN YES = 1 ELSE YES = 0
  473. 9140 IF YES = 1 THEN PRINT "Yes" ELSE PRINT "No"
  474. 9150 RETURN
  475. 9190 '
  476. 9200 '   ***   Select keyfield for printing labels   ***
  477. 9210 '
  478. 9220 CLS : PRINT : PRINT "     You may print labels selectively, based on the ten data fields stored in"
  479. 9230 PRINT "each record.  Select your key field, then specify the key.  For example, if"
  480. 9240 PRINT "you select a keyfield of `City' and a key of `Detroit', then only people"
  481. 9250 PRINT "living in Detroit will have their labels printed."
  482. 9260 PRINT "     The last two fields, activity and membership, are intended so that you can"
  483. 9270 PRINT "mail to only people with a specific interest or members of a specific club."
  484. 9280 PRINT "A good system is to assign a single letter of the alphabet as the key for each"
  485. 9290 PRINT "interest or organization on your list, allowing up to eight keys per name."
  486. 9300 PRINT : PRINT TAB(20) "Key fields are: ";CHR$(13);"     1.  First name";CHR$(13);"     2.  Middle Initial";CHR$(13);"     3.  Last Name"
  487. 9310 PRINT "     4.  Address";CHR$(13);"     5.  City";CHR$(13);"     6.  State";CHR$(13);"     7.  Zip code"
  488. 9320 PRINT "     8.  Phone #";CHR$(13);"     9.  Activity Key";CHR$(13);"    10.  Membership key"
  489. 9330 PRINT : INPUT "Input number of keyfield"; KEYFIELD
  490. 9340 KEYFIELD = INT(KEYFIELD) : IF KEYFIELD < 1 OR KEYFIELD > 10 THEN PRINT "Only use keyfield between 1 and 10, please." : GOTO 9310
  491. 9350 RETURN
  492. 9390 '
  493. 9400 '   ***   Sort Subroutine   ***
  494. 9410 '
  495. 9420 FOR I = 2 TO LASTRECORD
  496. 9430   IF SORT$(I) > SORT$(I-1) THEN 9560       '   skip if already in order
  497. 9450     FOR J = I-1 TO 0 STEP -1               '   find place to insert
  498. 9460     IF SORT$(I) > SORT$(J) THEN 9500
  499. 9470     NEXT J
  500. 9480   GOTO 9560
  501. 9500   TEMP$ = SORT$(I) : TEMP = SORT(I)        '   hold item to insert
  502. 9510   FOR K = I TO J+2 STEP -1                 '   bump others up
  503. 9520     SORT$(K) = SORT$(K-1) : SORT(K) = SORT(K-1)
  504. 9530   NEXT K
  505. 9540   SORT$(J+1) = TEMP$ : SORT(J+1) = TEMP    '   Insert index item
  506. 9560 NEXT I
  507. 9570 RETURN
  508. 9590 '
  509. 9600 '   ***   Delete index & record of deleted item   ***
  510. 9610 '
  511. 9620 COLOR FG, BG : GOSUB 8100   '   write blank form
  512. 9630 LOCATE 15,1 : PRINT SPACE$(80) : LOCATE 17,1 : PRINT SPACE$(80) : PRINT TAB(20) "DELETE RECORD . . .  Are you sure (y/n)? ";
  513. 9640 GOSUB 9100
  514. 9650 IF YES = 0 THEN RETURN 9810
  515. 9660 RESTORE : GOSUB 8800 : GOSUB 6100   '   Write blanks to disc
  516. 9670 GOSUB 1800     '   Add record # to free record list
  517. 9680 RETURN 9810
  518. 9690 '
  519. 9700 '   ***   Edit record   ***
  520. 9710 '
  521. 9730 CLS : MENU = 0
  522. 9740 GOSUB 6300
  523. 9750 GOSUB 8100
  524. 9760 RESTORE : GOSUB 8400
  525. 9770 RESTORE : READ DUMMY, DUMMY, DUMMY : ROW = 4 : COL = 13
  526. 9780 GOSUB 8500
  527. 9790 LOCATE 22,20 : COLOR FG,BG : PRINT "Store updated data on disc (yes/no)? "; : GOSUB 9100
  528. 9800 IF YES = 1 THEN RESTORE : GOSUB 8800 : GOSUB 6100
  529. 9810 LOCATE 22,10 : COLOR FG,BG : PRINT "(Strike any key to find next record or return to menu)"
  530. 9820 DUMMY$ = INKEY$ : IF DUMMY$ = "" THEN GOTO 9820
  531. 9830 MENU = 0 : RETURN
  532. 9890 '
  533. 9900 '   ***   Error Traps   ***
  534. 9910 '
  535. 9920 IF ERR = 57 THEN 9960
  536. 9925 IF ERR = 61 THEN 9965
  537. 9930 IF ERR = 68 THEN 9970
  538. 9935 IF ERR = 70 THEN 9975
  539. 9940 IF ERR = 71 THEN 9980
  540. 9945 IF ERR = 72 THEN 9985
  541. 9950 ON ERROR GOTO 0
  542. 9960 PRINT : PRINT "Disc I/O error.  No I/O took place.  Try another disc." : GOTO 9990
  543. 9965 PRINT : PRINT "Disc full.  Your last entry was not saved." : GOTO 9990
  544. 9970 PRINT : PRINT "Device unavailable.  Check installation." : GOTO 9990
  545. 9975 PRINT : PRINT "The disc is write protected.  Your entry was not saved."
  546. 9980 PRINT : PRINT "The disc was not ready.  No I/O took place." : GOTO 9990
  547. 9985 PRINT : PRINT "Media error.  Check for bad disc.  No I/O took place." : GOTO 9990
  548. 9990 PRINT : PRINT "Press any key to restart program. "
  549. 9995 Z$ = INKEY$ : IF Z$ = "" THEN 9995 ELSE CLOSE : RUN
  550. 9999 END
  551.